unit Unit1;

interface



uses
    SysUtils,
    Classes,
    Graphics,
    Windows,
    MedaxData,
    ExtCtrls,
    ComCtrls,
    Controls,
    Forms,
    MedaxUtils,
    Math,
    Gr32v1_5,
    dtpShape,
    dtpLineShape,
    dtpGroupShape,
    dtpPolygonShape,
    dtpTextShape,
    dtpDocument ;

type
    TMedaLayerObjectType = ( otEllipse, otRectangle, otRoundRect, otHTrace, otVTrace ) ;
    TMedaPageObjectType = ( otBox, otTPin, otRPin, otBPin, otLPin, otHLine, otVLine, otLabel ) ;
    TMedaElementType = ( etNone, etModule, etBox, etPin, etShape, etPad, etNet, etSignal ) ;
    TMedaLayerType = ( lcLayout, lcComponent, lcSolder, lcGround, lcPower, lcInner0, lcInner1, lcInner2, lcInner3, lcLast ) ;
    TMedaLayerTypeSet = set of TMedaLayerType ;
    TMedaPageNumber = 0..255 ;
    TMedaPageNumberSet = set of TMedaPageNumber ;
    TMedaDir = ( drNorth, drEast, drSouth, drWest ) ;
    TMedaDirSet = set of TMedaDir ;

const
    drHorizontal    : TMedaDirSet = [ drEast, drWest ] ;
    drVertical      : TMedaDirSet = [ drNorth, drSouth ] ;

type

    TMedaObject = class
    private
        { Private declarations }
        FSchemaGroup : TdtpGroupShape ;
        FPCBGroup : TdtpGroupShape ;
    protected
        { Protected declarations }
    public
        { Public declarations }
    end ;

    TMedaProject = class ;                                  { forward }
    TMedaElement = class ;
    TMedaBox = class ;
    TMedaNet = class ;
    TMedaPad = class ;
    TMedaPin = class ;

    TMedaElement = class( TMedaObject )
    private
        { Private declarations }
        FName : string ;
        FType : TMedaElementType ;
    protected
        { Protected declarations }
    public
        { Public declarations }
        constructor Create( Name : string ; EType : TMedaElementType ) ;
        destructor Destroy ; override ;
        property Name : string read FName ;
        procedure PublishOnSchema( Doc : TdtpDocument ) ; virtual ; abstract ;
        procedure PublishOnPCB( Doc : TdtpDocument ) ; virtual ; abstract ;
    published
        { Published declarations }
    end ;

    TMedaModule = class( TMedaElement )
    private
        { Private declarations }
        FProject : TMedaProject ;                           { owning project }
        FBoxes : TList ;                                    { all Boxes of this module }
        FNets : TList ;                                     { all Nets of this module }
        //    FLabels : TList ;							{ all labels of this module }
        FMedaPageData : TList ;                             { all graphical elements to show this module }
        FGrid : boolean ;                                   { draw grid flag }
    protected
        { Protected declarations }
    public
        { Public declarations }
        constructor Create( Name : string ; Project : TMedaProject ) ;
        function AddBox( Name, Family, Part : string ; X, Y : integer ) : TMedaBox ;
        function AddNet( Name : string ) : TMedaNet ;
        destructor Destroy ; override ;
        property Project : TMedaProject read FProject ;
        property Grid : boolean read FGrid write FGrid ;
    published
        { Published declarations }
    end ;

    TMedaNet = class( TMedaElement )
    private
        { Private declarations }
        FModule : TMedaModule ;                             { owning module }
        FPins : TList ;                                     { all pins on this net }
        FLines : TList ;                                    { all lines on this net }
        FLabels : TList ;                                   { all labels on this net }
        FTraces : TList ;                                   { PCB traces of the net }
        FVias : TList ;                                     { PCB vias of the net }
    protected
        { Protected declarations }
    public
        { Public declarations }
        constructor Create( Module : TMedaModule ; Name : string ) ;
        procedure AddLine( otType : TMedaPageObjectType ; X, Y, Z : integer ) ;
        procedure AddPin( Pin : TMedaPin ) ;
        procedure Join( Net : TMedaNet ) ;
        property Module : TMedaModule read FModule ;
    published
        { Published declarations }
    end ;

    TMedaShape = class( TMedaElement )
    private
        { Private declarations }
        FBox : TMedaBox ;                                   { Owner: Box in drawing linked to this Shape }
        FWidth, FHeight : integer ;                         { Shape width and height in mils }
        //    FPinSpacing: integer ;						{ pin to pin spacing in mics (microinches, 1/1000 of a mil) }
        FXpos, FYPos : integer ;                            { Shape position on layer in mils }
        FRotation : TMedaDir ;                              { angular rotation of Shape in microradians, only right angled for the moment }
        FLayer : TMedaLayerType ;                           { Layer of appearance }
        FPads : TList ;                                     { Pads of the Shape }
        FPins : integer ;                                   { number of pins/pads of the shape }
    protected
        { Protected declarations }
    public
        { Public declarations }
        constructor Create( Box : TMedaBox ; Shape : string ; X, Y : integer ; Layer : TMedaLayerType ; Rotation : TMedaDir ) ;
        destructor Destroy ; override ;
        property X : integer read FXpos write FYPos ;
        property Y : integer read FYpos write FYPos ;
        property Width : integer read FWidth ;
        property Height : integer read FHeight ;
        property Layer : TMedaLayerType read FLayer write FLayer ;
    published
        { Published declarations }
    end ;

    TMedaBox = class( TMedaElement )
    private
        { Private declarations }
        FModule : TMedaModule ;                             { Hyperlink: Module of Box appearance }
        FShape : TMedaShape ;                               { Shape on PCB linked to this Box }
        FFamily, FPart : string ;
        FWidth, FHeight : integer ;                         { Box width and height in Meda units }
        FXpos, FYPos : integer ;                            { Box position on sheet in Meda units }
        FPins : TList ;                                     { Pins of the Box }
    protected
        { Protected declarations }
    public
        { Public declarations }
        constructor Create( Module : TMedaModule ; Name, Family, Part : string ; X, Y : integer ) ;
        procedure PlaceShape( PCBShape : string ; X, Y : integer ; Layer : TMedaLayerType ; Rotation : TMedaDir ) ;
        property Module : TMedaModule read FModule ;
        property X : integer read FXpos write FYPos ;
        property Y : integer read FYpos write FYPos ;
        property W : integer read FWidth write FWidth ;
        property H : integer read FHeight write FHeight ;
        property Page : TMedaModule read FModule ;
        property Shape : TMedaShape read FShape write FShape ;
        property Pins : TList read FPins write FPins ;
    published
        { Published declarations }
    end ;

    TMedaPin = class( TMedaElement )
    private
        { Private declarations }
        FBox : TMedaBox ;
        FPos : string ;                                     { Pin position on box edge }
        //	FPad : TMedaPad ;							{ hyperlink to pad in PCB }
        FNumber : integer ;                                 { Pin number value }
    protected
        { Protected declarations }
    public
        { Public declarations }
        constructor Create( Box : TMedaBox ; Name : string ; Number : integer ; Position : string ) ;
        function GetDirection : TMedaDirSet ;
        function GetX : integer ;
        function GetY : integer ;
        property Box : TMedaBox read FBox ;
        property Number : integer read FNumber ;
        property Direction : TMedaDirSet read GetDirection ;
        property X : integer read GetX ;
        property Y : integer read GetY ;
    published
        { Published declarations }
    end ;

    TMedaStack = class( TMedaElement )
    private
        { Private declarations }
    //	FOwner : TMedaPad ;
        FPadWidth : array[ TMedaLayerType ] of integer ;    { width of pad on the every layer }
        FPadHeight : array[ TMedaLayerType ] of integer ;   { height of pad on the every layer }
        FPadType : char ;                                   { Pad type, Round, Rectangle, Rounded Rectangle, ... }
        FHole : integer ;                                   { Hole size in mils }
    protected
        { Protected declarations }
        constructor Create( Pad : string ; Rotation : TMedaDir ) ;
        function GetPadWidth( i : TMedaLayerType ) : integer ;
        procedure SetPadWidth( i : TMedaLayerType ; NewValue : integer ) ;
        function GetPadHeight( i : TMedaLayerType ) : integer ;
        procedure SetPadHeight( i : TMedaLayerType ; NewValue : integer ) ;
        procedure Free ;
    public
        { Public declarations }
        property Hole : integer read FHole write FHole ;
        property PadType : char read FPadType write FPadType ;
        property PadWidth[ i : TMedaLayerType ] : integer read GetPadWidth write SetPadWidth ;
        property PadHeight[ i : TMedaLayerType ] : integer read GetPadHeight write SetPadHeight ;
    published
        { Published declarations }
    end ;

    TMedaPad = class( TMedaElement )
    private
        { Private declarations }
        FShape : TMedaShape ;                               { Pad is part of this Shape }
        FXpos, FYPos : integer ;                            { Pad position in mils }
        FStack : TMedaStack ;                               { Pad Stack definition }
        FPin : TMedaPin ;                                   { Hyper linked to this Pin }
    protected
        { Protected declarations }
    public
        { Public declarations }
        constructor Create( Project : TMedaProject ; Owner : TMedaShape ; HyperLink : TMedaPin ; X, Y : integer ; Rotation : TMedaDir ; Stack : TMedaStack ) ;
        destructor Destroy ; override ;
        property X : integer read FXpos write FYPos ;
        property Y : integer read FYpos write FYPos ;
    published
        { Published declarations }
    end ;

    TMedaVia = class
    private
        { Private declarations }
        FXpos, FYPos : integer ;                            { Via position in mils }
        FStack : TMedaStack ;                               { Via Stack definition }
    protected
        { Protected declarations }
    public
        { Public declarations }
        constructor Create( X, Y : integer ) ;
        destructor Destroy ; override ;
        property X : integer read FXpos write FYPos ;
        property Y : integer read FYpos write FYPos ;
        property Stack : TMedaStack read FStack write FStack ;
    published
        { Published declarations }
    end ;

    TMedaLabel = class( TMedaElement )
    private
        { Private declarations }
    //	FNodes : TList ;							{ Nodes of the Label }
    protected
        { Protected declarations }
    public
        { Public declarations }
    published
        { Published declarations }
    end ;

    TMedaTrack = class( TMedaElement )
    private
        { Private declarations }
    protected
        { Protected declarations }
    public
        { Public declarations }
    published
        { Published declarations }
    end ;

    TMedaLayer = class( TMedaElement )
    private fObjects : TList ;
        function GetCount : integer ;
        function GetItems( i : integer ) : TMedaObject ;
        { Private declarations }
    protected
        { Protected declarations }
    public
        { Public declarations }
        constructor Create( layer : TMedaLayerType ) ;
        destructor Destroy ; override ;
        property Count : integer read GetCount ;
        property Items[ i : integer ] : TMedaLayerObject read GetItems ;
        procedure Add( obj : TMedaLayerObject ) ;
    published
        { Published declarations }
    end ;

    TMedaProject = class
    private
        { Private declarations }
        FName : string ;
        FModules : TList ;
        FCurrentModule : TMedaModule ;                      { the current active module }
        FCurrentPage : TMedaPageNumber ;                    { the current active page }
        FCurrentLayer : TMedaLayerType ;                    { the current active layer }
        FMedaLayers : array[ TMedaLayerType ] of TMedaLayer ;
        FMedaPages : array[ TMedaPageNumber ] of TMedaModule ;
        FSheetWidth, FSheetHeight : integer ;               { sheet width and Height in Meda units }
    protected
        { Protected declarations }
    public
        { Public declarations }
        constructor Create( Name : string ) ;
        destructor Destroy ; override ;
        function AddModule( Name : string ) : TMedaModule ;
        procedure CreatePages( pages : TMedaPageNumberSet ) ;
        procedure CreateLayers( layers : TMedaLayerTypeSet ) ;
        procedure AddLayerObject( Owner : TMedaElement ; layer : TMedaLayerType ; otType : TMedaLayerObjectType ; X, Y, Width, Height : integer ) ;
        procedure PaintLayer( Document : TdtpDocument ; l : TMedaLayerTYpe ) ;
        function LayerHitTest( l : TMedaLayerType ; X, Y : integer ) : boolean ;
        property Name : string read FName ;
        property CurrentModule : TMedaModule read FCurrentModule write FCurrentModule ;
        property CurrentLayer : TMedaLayerType read FCurrentLayer write FCurrentLayer ;
    published
        { Published declarations }
    end ;

type
  TDataModule1 = class(TDataModule)
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  DataModule1: TDataModule1;
implementation

{ TMedaLayerObject }

constructor TMedaLayerObject.Create( Owner : TMedaElement ; otType : TMedaLayerObjectType ; X, Y, Width, Height : integer ) ;
begin
    inherited Create ;
    FOwner := Owner ;
    FType := otType ;
    with FRect do
        case otType of
            otHTrace : begin
                    Left := X - Height div 2 ;
                    Top := Y - Height div 2 ;
                    Right := Width + Height div 2 + 1 ;
                    Bottom := Y + Height div 2 + 1 ;
                end ;
            otVtrace : begin
                    Left := X - Height div 2 ;
                    Top := Y - Height div 2 ;
                    Right := X + Height div 2 + 1 ;
                    Bottom := Width + Height div 2 + 1 ;
                end ;
        else
            Left := X - Width div 2 ;
            Top := Y - Height div 2 ;
            Right := X + Width div 2 + 1 ;
            Bottom := Y + Height div 2 + 1 ;
        end ;
end ;

procedure TMedaLayerObject.Publish( Document : TdtpDocument ) ;
var
    w               : extended ;
    Shape           : TdtpPolygonShape ;
begin
    with Document, FRect do begin
        case FType of
            otEllipse : Shape := TdtpEllipseShape.Create ;
            otRectangle : Shape := TdtpRectangleShape.Create ;
            otHTrace, otVTrace, otRoundRect : begin
                    if Right - Left < Bottom - Top then
                        w := Right - Left
                    else
                        w := Bottom - Top ;
                    Shape := TdtpRoundRectShape.Create ;
                end ;
        else
            Exit ;
        end ;
        Shape.Tag := integer( Self ) ;                      // backlink
        Document.ShapeAdd( Shape ) ;
        Shape.DocRect := FRect ;
    end ;
end ;

{ TMedaPageObject }

constructor TMedaPageObject.Create( Owner : TMedaElement ; otType : TMedaPageObjectType ; X, Y, Width, Height : integer ) ;
begin
    inherited Create ;
    FType := otType ;
    FOwner := Owner ;
    case otType of
        otBox :
            with FRect do begin
                Left := X ;
                Top := Y ;
                Right := X + Width + 1 ;
                Bottom := Y + Height + 1 ;
            end ;
        otTPin, otRPin, otBPin, otLPin :
            with FRect do begin
                Left := X ;
                Top := Y ;
            end ;
        otHLine :
            with FRect do begin
                Left := Min( X, Width ) ;
                Top := Y ;
                Right := Max( X, Width ) ;
            end ;
        otVLine :
            with FRect do begin
                Left := X ;
                Top := Min( Y, Width ) ;
                Bottom := Max( Y, Width ) ;
            end ;
    end ;
end ;

procedure TMedaPageObject.Publish( Doc : tdtpDocument ) ;
var
    Shape           : TdtpShape ;
    R               : TFloatRect ;
begin
    case FType of
        otBox : begin
                Shape := TdtpRectangleShape.Create ;
                with Shape as TdtpRectangleShape do begin
                    Tag := integer( Self ) ;
                    Doc.ShapeAdd( Shape ) ;
                    with FRect do
                        DocRect := FloatRect( Left, Top, Right, Top ) ;
                end ;
                Shape := TdtpTextShape.Create ;
                with Shape as TdtpTextShape do begin
                    Text := FOwner.Name ;
                    Tag := integer( Self ) ;
                    Doc.ShapeAdd( Shape ) ;
                    with FRect do
                        DocRect := FloatRect( Left, Top, Right, Top ) ;
                end ;
            end ;
    else
        Shape := TdtpLineShape.Create ;
        with Shape as TdtpLineShape do begin
            Tag := integer( Self ) ;
            Doc.ShapeAdd( Shape ) ;
            with FRect do
                DocRect := FloatRect( Left, Top, Right, Bottom ) ;
            Shape := TdtpTextShape.Create ;
            with Shape as TdtpTextShape do begin
                Text := FOwner.Name ;
                Tag := integer( Self ) ;
                Doc.ShapeAdd( Shape ) ;
                with FRect do
                    DocRect := FloatRect( Left, Top, Right, Top ) ;
                if Self is TMedaPin then
                    with Self as TMedaPin do
                        case Direction of
                            drNorth : DocRotate( 90 ) ;
                            drSouth : DocRotate( 90 ) ;
                            drWest : ;
                        end ;
            end ;
        end ;
    end ;
end ;

{ TMedaProject }

constructor TMedaProject.Create( Name : string ) ;
var
    i               : TMedaLayerType ;
begin
    inherited Create ;
    FName := Name ;
    FModules := TList.Create ;
    FCurrentLayer := lcComponent ;
    for i := Low( TMedaLayerType ) to High( TMedaLayerType ) do
        FMedaLayers[ i ] := TMedaLayer.Create( i ) ;
end ;

function TMedaProject.AddModule( Name : string ) : TMedaModule ;
begin
    Result := TMedaModule.Create( Name, Self ) ;
    FModules.Add( Result ) ;
    FCurrentModule := Result ;
end ;

procedure TMedaProject.AddLayerObject( Owner : TMedaElement ; layer : TMedaLayerType ; otType : TMedaLayerObjectType ; X, Y, Width, Height : integer ) ;
begin
    FMedaLayers[ layer ].Add( TMedaLayerObject.Create( Owner, otType, X, Y, Width, Height ) ) ;
end ;

procedure TMedaProject.PaintLayer( Document : TdtpDocument ; l : TMedaLayerType ) ;
var
    i               : integer ;
begin
    if FMedaLayers[ l ] <> nil then
        with FMedaLayers[ l ] do
            for i := 0 to Count - 1 do
                Items[ i ].Publish( PaintBox ) ;
end ;

function TMedaProject.LayerHitTest( l : TMedaLayerType ; X, Y : integer ) : boolean ;
var
    i               : integer ;
begin
    if FMedaLayers[ l ] <> nil then
        with FMedaLayers[ l ] do
            for i := 0 to Count - 1 do
                if Items[ i ].HitTest( X, Y ) then begin
                    Result := True ;
                    Exit ;
                end ;
    Result := False ;
end ;

destructor TMedaProject.Destroy ;
begin
    inherited Destroy ;
end ;

procedure TMedaProject.CreateLayers( layers : TMedaLayerTypeSet ) ;
begin

end ;

procedure TMedaProject.CreatePages( pages : TMedaPageNumberSet ) ;
begin

end ;

{ TMedaElement }

constructor TMedaElement.Create( Name : string ; EType : TMedaElementType ) ;
begin
    inherited Create ;
    FName := Name ;
    FType := EType ;
end ;

function TMedaElement.AsPin : TMedaPin ;
begin
    Result := TMedaPin( Self ) ;
end ;

function TMedaElement.AsNet : TMedaNet ;
begin
    Result := TMedaNet( Self ) ;
end ;

function TMedaElement.AsBox : TMedaBox ;
begin
    Result := TMedaBox( Self ) ;
end ;

destructor TMedaElement.Destroy ;
begin
    inherited Destroy ;
end ;

{ TMedaModule }

constructor TMedaModule.Create( Name : string ; Project : TMedaProject ) ;
begin
    inherited Create( Name, etModule ) ;
    FProject := Project ;
    FBoxes := TList.Create ;
    FNets := TList.Create ;
    FMedaPageData := TList.Create ;
    FGrid := True ;
end ;

function TMedaModule.AddBox( Name, Family, Part : string ; X, Y : integer ) : TMedaBox ;
begin
    Result := TMedaBox.Create( Self, Name, Family, Part, X, Y ) ;
    FBoxes.Add( Result ) ;
end ;

function TMedaModule.AddNet( Name : string ) : TMedaNet ;
begin
    Result := TMedaNet.Create( Self, Name ) ;
    FNets.Add( Result ) ;
end ;

procedure TMedaModule.AddPageObject( Owner : TMedaElement ; otType : TMedaPageObjectType ; X, Y, Width, Height : integer ) ;
begin
    FMedaPageData.Add( TMedaPageObject.Create( Owner, otType, X, Y, Width, Height ) ) ;
end ;

procedure TMedaModule.Publish( Document : TdtpDocument ) ;
var
    i, j, hFont     : integer ;
begin
    with PaintBoxH do begin
        Canvas.Font.Name := 'Courier New' ;
        Canvas.Font.Height := Tag ;
        Canvas.Font.Color := clNavy ;
        Canvas.Font.Style := [ fsBold ] ;
        SetBkMode( Canvas.Handle, TRANSPARENT ) ;
        if Self.FGrid and ( Tag > 8 ) then
            for i := -Left div Tag to -Left div Tag + 80 do
                for j := -Top div Tag to -Top div Tag + 60 do
                    SetPixel( Canvas.Handle, i * Tag, j * Tag, $007F00 ) ;
        Canvas.MoveTo( 0, 0 ) ;
        Canvas.LineTo( Width - 1, 0 ) ;
        Canvas.LineTo( Width - 1, Height - 1 ) ;
        Canvas.LineTo( 0, Height - 1 ) ;
        Canvas.LineTo( 0, 0 ) ;
    end ;
    with PaintBoxV.Canvas do begin
        Font.Color := clNavy ;
        { no font orientation in Delphi }
        hFont := CreateFont( PaintBoxH.Tag, 0, 900, 900, FW_BOLD, 0, 0, 0, 0, 0, 0, 0, 0, 'Courier New' ) ;
        hFont := SelectObject( Handle, hFont ) ;
        SetBkMode( Handle, TRANSPARENT ) ;
    end ;
    if FMedaPageData <> nil then
        with FMedaPageData do
            for i := 0 to Count - 1 do
                TMedaPageObject( Items[ i ] ).Publish( PaintBoxH, PaintBoxV ) ;
    SelectObject( PaintBoxV.Canvas.Handle, hFont ) ;
    DeleteObject( hFont ) ;
end ;

function TMedaModule.HitTest( X, Y, Zoom : Integer ) : TMedaElement ;
var
    i               : integer ;
begin
    Result := nil ;
    X := ( X + Zoom div 2 ) div Zoom ;
    Y := ( Y + Zoom div 2 ) div Zoom ;
    if FMedaPageData <> nil then
        with FMedaPageData do
            for i := Count - 1 downto 0 do
                if TMedaPageObject( Items[ i ] ).HitTest( X, Y ) then begin
                    Result := TMedaPageObject( Items[ i ] ).Owner ;
                    Break ;
                end ;
end ;

procedure TMedaModule.PlaceOnPCB( NameOfBox, PCBShape : string ; X, Y : integer ; Layer : TMedaLayerType ; Rotation : TMedaDir ) ;
var
    i               : integer ;
    Box             : TMedaBox ;
begin
    for i := 0 to FBoxes.Count - 1 do begin
        Box := TMedaBox( FBoxes.Items[ i ] ) ;
        if Box <> nil then
            if Box.Name = NameOfBox then begin
                Box.PlaceShape( PCBShape, X, Y, Layer, Rotation ) ;
                Break ;
            end ;
    end ;
end ;

destructor TMedaModule.Destroy ;
begin
    inherited Destroy ;
end ;

{ TMedaNet }

constructor TMedaNet.Create( Module : TMedaModule ; Name : string ) ;
begin
    inherited Create( Name, etNet ) ;
    FModule := Module ;
    FPins := TList.Create ;
    FLines := TList.Create ;
    FLabels := TList.Create ;
    FTraces := TList.Create ;
    FVias := TList.Create ;
end ;

procedure TMedaNet.Join( Net : TMedaNet ) ;
begin
    // join other net to us by:
      // check if same module
    if FModule <> Net.Module then
        Exit ;
    // copy all lines, pins, traces, vias and labels
    // assign all pageobjects to us
    // free other net
end ;

procedure TMedaNet.AddLine( otType : TMedaPageObjectType ; X, Y, Z : integer ) ;
begin
    FModule.AddPageObject( Self, otType, X, Y, Z, 1 ) ;
    //	FLines.Add(  ) ;
end ;

procedure TMedaNet.AddPin( Pin : TMedaPin ) ;
begin
    FPins.Add( Pin ) ;
end ;

{ TMedaShape }

constructor TMedaShape.Create( Box : TMedaBox ; Shape : string ; X, Y : integer ; Layer : TMedaLayerType ; Rotation : TMedaDir ) ;
var
    XPad, YPad, i   : integer ;
    MyStack0, MyStack1 : TMedaStack ;
    nPinSpacing, nRowSpacing, nColumnSpacing : integer ;
    sType, sPad     : string ;
    Pin             : TMedaPin ;
begin
    inherited Create( Box.Name, etShape ) ;
    FBox := Box ;
    FXpos := X ;
    FYpos := Y ;
    FLayer := Layer ;
    FRotation := Rotation ;
    FPads := TList.Create ;
    // read shape database for <Shape> here and build pads from that
    with MedaxDataModule.Shapes do
        if FindKey( [ Shape ] ) then begin
            sType := FindField( 'Type' ).AsString ;
            FWidth := FindField( 'BoxWidth' ).AsInteger ;
            FHeight := FindField( 'BoxHeight' ).AsInteger ;
            nPinSpacing := FindField( 'PinSpacing' ).AsInteger ;
            nRowSpacing := FindField( 'RowSpacing' ).AsInteger div 2 ;
            nColumnSpacing := FindField( 'ColumnSpacing' ).AsInteger div 2 ;
            sPad := FindField( 'Pad' ).AsString ;
            FPins := FindField( 'Pins' ).AsInteger ;
            MyStack0 := TMedaStack.Create( sPad, Rotation ) ;
            FPads.Capacity := FPins ;
            { create the outline in the layout layer }
            if Rotation in drVertical then begin
                FBox.Module.Project.AddLayerObject( Self, lcLayout, otRectangle, FXPos, FYPos, FHeight, FWidth ) ;
                i := X ;
                X := Y ;
                Y := i ;
            end
            else
                FBox.Module.Project.AddLayerObject( Self, lcLayout, otRectangle, FXPos, FYPos, FWidth, FHeight ) ;

            if LowerCase( sType ) = 'dil' then begin
                for i := 0 to FPins div 2 - 1 do begin
                    if ( FBox <> nil ) and ( FBox.Pins <> nil ) then
                        Pin := FBox.Pins.Items[ i ]
                    else
                        Pin := nil ;
                    XPad := X + ( i * nPinSpacing - ( FPins div 2 - 1 ) * nPinSpacing div 2 ) div 1000 ;
                    FPads.Add( TMedaPad.Create( FBox.Module.Project, Self, Pin, XPad, Y - nRowSpacing, Rotation, MyStack0 ) ) ;
                    FPads.Add( TMedaPad.Create( FBox.Module.Project, Self, Pin, XPad, Y + nRowSpacing, Rotation, MyStack0 ) ) ;
                end ;
            end
            else if ( LowerCase( sType ) = 'plcc' ) or ( LowerCase( sType ) = 'qfp' ) then begin
                MyStack1 := TMedaStack.Create( sPad, Succ( Rotation ) ) ;
                for i := 0 to FPins div 4 - 1 do begin
                    Xpad := X + ( i * nPinSpacing - ( FPins div 4 - 1 ) * nPinSpacing div 2 ) div 1000 ;
                    if ( FBox <> nil ) and ( FBox.Pins <> nil ) then
                        Pin := FBox.Pins.Items[ i ]
                    else
                        Pin := nil ;
                    FPads.Add( TMedaPad.Create( FBox.Module.Project, Self, Pin, XPad, Y - nColumnSpacing, Rotation, MyStack0 ) ) ;
                    FPads.Add( TMedaPad.Create( FBox.Module.Project, Self, Pin, XPad, Y + nColumnSpacing, Rotation, MyStack0 ) ) ;
                end ;
                for i := 0 to FPins div 4 - 1 do begin
                    if ( FBox <> nil ) and ( FBox.Pins <> nil ) then
                        Pin := FBox.Pins.Items[ i ]
                    else
                        Pin := nil ;
                    YPad := Y + ( i * nPinSpacing - ( FPins div 4 - 1 ) * nPinSpacing div 2 ) div 1000 ;
                    FPads.Add( TMedaPad.Create( FBox.Module.Project, Self, Pin, X - nRowSpacing, YPad, Rotation, MyStack1 ) ) ;
                    FPads.Add( TMedaPad.Create( FBox.Module.Project, Self, Pin, X + nRowSpacing, YPad, Rotation, MyStack1 ) ) ;
                end ;
            end ;
        end ;
end ;

destructor TMedaShape.Destroy ;
begin
    // free all our Pads
    with FPads do begin
        while Last <> nil do
            TMedaPad( Last ).Free ;
        Free ;
    end ;
    inherited Destroy ;
end ;

{ TMedaBox }

constructor TMedaBox.Create( Module : TMedaModule ; Name, Family, Part : string ; X, Y : integer ) ;
var
    sBox            : string ;
begin
    inherited Create( Name, etBox ) ;
    FPins := TList.Create ;
    FModule := Module ;
    FFamily := Family ;
    FPart := Part ;
    FXPos := X ;
    FYPos := Y ;
    with MedaxDataModule.Parts do begin
        CancelRange ;
        if FindKey( [ Family, Part ] ) then begin
            sBox := FindField( 'Box' ).AsString ;
            with MedaxDataModule.Boxes do
                if FindKey( [ sBox ] ) then begin
                    FWidth := FindField( 'Width' ).AsInteger ;
                    FHeight := FindField( 'Height' ).AsInteger ;
                    Module.AddPageObject( Self, otBox, X, Y, FWidth, FHeight ) ;
                    with MedaxDataModule.Pins do begin
                        CancelRange ;
                        SetRange( [ sBox ], [ sBox ] ) ;
                        First ;
                        while not EOF do begin
                            FPins.Add(
                                TMedaPin.Create(
                                Self,
                                FindField( 'Label' ).AsString,
                                FindField( 'Pin' ).AsInteger,
                                FindField( 'Position' ).AsString )
                                ) ;
                            Next ;
                        end ;
                    end ;
                end ;
        end ;
    end ;
end ;

procedure TMedaBox.PlaceShape( PCBShape : string ; X, Y : integer ; Layer : TMedaLayerType ; Rotation : TMedaDir ) ;
begin
    FShape := TMedaShape.Create( Self, PCBShape, X, Y, Layer, Rotation ) ;
end ;

{ TMedaPin }

constructor TMedaPin.Create( Box : TMedaBox ; Name : string ; Number : integer ; Position : string ) ;
var
    nPos            : integer ;
begin
    inherited Create( Name, etPin ) ;
    FBox := Box ;
    FNumber := Number ;
    FPos := Position ;
    nPos := StrToInt( System.Copy( Position, 2, 3 ) ) ;
    case FPos[ 1 ] of
        'T' : Box.Module.AddPageObject( Self, otTPin, Box.X + nPos + 1, Box.Y, 0, 0 ) ;
        'R' : Box.Module.AddPageObject( Self, otRPin, Box.X + Box.W + 1, Box.Y + nPos, 0, 0 ) ;
        'B' : Box.Module.AddPageObject( Self, otBPin, Box.X + nPos, Box.Y + Box.H + 1, 0, 0 ) ;
        'L' : Box.Module.AddPageObject( Self, otLPin, Box.X, Box.Y + nPos, 0, 0 ) ;
    end ;
end ;

function TMedaPin.GetDirection : TMedaDirSet ;
begin
    case FPos[ 1 ] of
        'T' : Result := [ drNorth ] ;
        'R' : Result := [ drEast ] ;
        'B' : Result := [ drSouth ] ;
        'L' : Result := [ drWest ] ;
    end ;
end ;

function TMedaPin.GetX : integer ;
var
    nPos            : integer ;
begin
    Result := 0 ;
    nPos := StrToInt( System.Copy( FPos, 2, 3 ) ) ;
    case FPos[ 1 ] of
        'T' : Result := Box.X + nPos + 1 ;
        'R' : Result := Box.X + Box.W + 1 ;
        'B' : Result := Box.X + nPos ;
        'L' : Result := Box.X ;
    end ;
end ;

function TMedaPin.GetY : integer ;
var
    nPos            : integer ;
begin
    Result := 0 ;
    nPos := StrToInt( System.Copy( FPos, 2, 3 ) ) ;
    case FPos[ 1 ] of
        'T' : Result := Box.Y ;
        'R' : Result := Box.Y + nPos ;
        'B' : Result := Box.Y + Box.H + 1 ;
        'L' : Result := Box.Y + nPos ;
    end ;
end ;

{ TMedaStack }

constructor TMedaStack.Create( Pad : string ; Rotation : TMedaDir ) ;
var
    i               : TMedaLayerType ;
begin
    if Pad = 'Via' then begin
        FPadType := 'V' ;
        for i := lcComponent to lcInner3 do begin
            FPadWidth[ i ] := 25 ;
            FPadHeight[ i ] := 25 ;
        end ;
        FPadWidth[ lcGround ] := -25 ;
        FPadHeight[ lcPower ] := -25 ;
    end
    else
        with MedaxDataModule.Pads do
            if FindKey( [ Pad ] ) then begin
                FPadType := FindField( 'PadShape' ).AsString[ 1 ] ;
                case FPadType of
                    'C' : begin
                            FPadWidth[ lcComponent ] := FindField( 'TopPadWidth' ).AsInteger ;
                            FPadHeight[ lcComponent ] := FindField( 'TopPadWidth' ).AsInteger ;
                            FPadWidth[ lcSolder ] := FindField( 'BottomSize' ).AsInteger ;
                            FPadHeight[ lcSolder ] := FPadWidth[ lcSolder ] ;
                            for i := lcInner0 to lcInner3 do begin
                                FPadWidth[ i ] := FindField( 'InternalSize' ).AsInteger ;
                                FPadHeight[ i ] := FPadWidth[ i ] ;
                            end ;
                            FPadWidth[ lcGround ] := -FPadWidth[ lcInner0 ] ;
                            FPadHeight[ lcPower ] := -FPadWidth[ lcInner0 ] ;
                        end ;
                    'R', 'E', 'O' : begin
                            if Rotation in [ drNorth, drSouth ] then begin
                                FPadWidth[ lcComponent ] := FindField( 'TopPadWidth' ).AsInteger ;
                                FPadHeight[ lcComponent ] := FindField( 'TopPadHeight' ).AsInteger ;
                            end
                            else begin
                                FPadHeight[ lcComponent ] := FindField( 'TopPadWidth' ).AsInteger ;
                                FPadWidth[ lcComponent ] := FindField( 'TopPadHeight' ).AsInteger ;
                            end ;
                        end ;
                end ;
            end ;
end ;

function TMedaStack.GetPadWidth( i : TMedaLayerType ) : integer ;
begin
    Result := FPadWidth[ i ]
end ;

procedure TMedaStack.SetPadWidth( i : TMedaLayerType ; NewValue : integer ) ;
begin
    FPadWidth[ i ] := NewValue ;
end ;

function TMedaStack.GetPadHeight( i : TMedaLayerType ) : integer ;
begin
    Result := FPadHeight[ i ]
end ;

procedure TMedaStack.SetPadHeight( i : TMedaLayerType ; NewValue : integer ) ;
begin
    FPadHeight[ i ] := NewValue ;
end ;

procedure TMedaStack.Free ;
begin
    if Self <> nil then
        inherited Destroy ;
end ;

{ TMedaPad }

constructor TMedaPad.Create( Project : TMedaProject ; Owner : TMedaShape ; HyperLink : TMedaPin ; X, Y : integer ; Rotation : TMedaDir ; Stack : TMedaStack ) ;
var
    i               : TMedaLayerType ;
begin
    if HyperLink <> nil then
        inherited Create( HyperLink.Name, etPad )
    else
        inherited Create( '', etPad ) ;
    FPin := HyperLink ;
    FShape := Owner ;
    if Rotation in [ drNorth, drSouth ] then begin
        FXpos := X ;
        FYpos := Y ;
    end
    else if Rotation in [ drNorth, drSouth ] then begin
        FXpos := Y ;
        FYpos := X ;
    end
    else begin
        FXPos := 0 ;
        FYPos := 0 ;
    end ;
    FStack := Stack ;
    case FStack.PadType of
        'V', 'E', 'C' :
            for i := lcComponent to lcLast do
                Project.AddLayerObject( Self, i, otEllipse, FXPos, FYPos, FStack.PadWidth[ i ], FStack.PadHeight[ i ] ) ;
        'R' :
            Project.AddLayerObject( Self, lcComponent, otRectangle, FXPos, FYPos, FStack.PadWidth[ lcComponent ], FStack.PadHeight[ lcComponent ] ) ;
        'O' :
            Project.AddLayerObject( Self, lcComponent, otRoundRect, FXPos, FYPos, FStack.PadWidth[ lcComponent ], FStack.PadHeight[ lcComponent ] ) ;
    end ;
end ;

destructor TMedaPad.Destroy ;
begin
    FStack.Free ;
    inherited Destroy ;
end ;

{ TMedaVia }

constructor TMedaVia.Create( X, Y : integer ) ;
begin
    inherited Create ;
    FXpos := X ;
    FYpos := Y ;
    FStack := TMedaStack.Create( 'Via', drNorth ) ;
end ;

destructor TMedaVia.Destroy ;
begin
    FStack.Free ;
    inherited Destroy ;
end ;

{ TMedaLayer }

procedure TMedaLayer.Add( obj : TMedaLayerObject ) ;
begin
    fObjects.Add( obj ) ;
end ;

constructor TMedaLayer.Create( layer : TMedaLayerType ) ;
begin
    fObjects := TList.Create ;
end ;

destructor TMedaLayer.Destroy ;
begin
    fObjects.Free ;
    inherited ;
end ;

function TMedaLayer.GetCount : integer ;
begin
    Result := fObjects.Count ;
end ;

function TMedaLayer.GetItems( i : integer ) : TMedaLayerObject ;
begin
    Result := TObject( fObjects[ i ] ) as TMedaLayerObject ;
end ;

end.

